(use-modules (srfi srfi-37))

;; store the options globally
(define options (make-hash-table 10))

;; make a procedure that only displays message and then exits
(define (display-and-exit-proc msg)
  ;; needs to take the mandatory arguments though
  (lambda (opt name arg loads)
    ;; now only display
    (display msg)
    ;; and then quit the program
    (quit)))

(define* (make-store-in-options-proc #:optional (key #f))
  "Make a processor, which stores the option in the options hash
table, optionally taking a key under which to store the value."
  (lambda (opt name arg loads)
    (display
     (simple-format #f
                    "storing the following option and value: ~a, ~a\n"
                    (if key key name)
                    arg))
    (if key
        (hash-set! options key arg)
        (hash-set! options name arg))
    ;; "and the processor should return seeds as well."
    loads))

(define usage-help
  (string-join '(""
                 "foo.scm [options]"
                 "-v,  --version    Display version"
                 "-h,  --help       Display this help"
                 "-u,  --user-name  user name greeted by this program"
                 "-n,  --times      number of greetings"
                 "")
               "\n"))

(define option-spec
  ;; args-fold calls the processors of the options with the following arguments:
  ;; - the containing option object,
  ;; - the name used on the command line,
  ;; - the argument given for the option (or #f if none)
  ;; - the rest of the arguments are args-fold “seeds”
  ;;   and the processor should return seeds as well.
  ;; specify the options in a list of option objects
  (list (option '(#\v "version")  ; short name and long name
                #f  ; required-arg? - option must be followed by an argument
                #f  ; optional-arg? - option takes an argument if available
                (display-and-exit-proc "Foo version 42.0\n"))  ; processor of option
        (option '(#\h "help") #f #f
                (display-and-exit-proc usage-help))
        (option '(#\u "user-name") #t #f
                (make-store-in-options-proc "user-name"))
        (option '(#\n "times") #t #f
                (λ (opt name arg loads)
                  (cond
                   [(exact-integer? (string->number arg))
                    ((make-store-in-options-proc "times") opt name arg loads)]
                   [else
                    (error
                     (simple-format #f
                                    "option predicate for option ~a not true: ~a"
                                    name "(exact-integer? (string->number arg))"))])))))


(args-fold
 ;; (program-arguments) simply contains all arguments to the guile command
 ;; We do not need the filename of the program, so we discard it and only use the cdr.
 (cdr (program-arguments))
 ;; use previously defined option specification
 option-spec
 ;; What happens when unknown arguments are given?
 ;; Unknown argument handling procedure.
 (lambda (opt name arg loads)
   (error (simple-format #f "Unrecognized option: ~A\n~A" name usage-help)))
 ;; Call operand-proc with any items on the command line that are not named options.
 ;; This includes arguments after ‘--’.
 ;; It is called with the argument in question, as well as the seeds.
 (lambda (op loads)
   (cons op loads))
 ;; seed - What is the seed???
 '())

(define (main options)
  (let ([user-name (hash-ref options "user-name" #f)]
        [times (string->number (hash-ref options "times" "1"))])
  (do ([i 0 (1+ i)])
      ([>= i times])
    (display (simple-format #f "Hello ~a!\n" (if user-name
                                                  user-name
                                                  "World"))))))

(main options)
